home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / system-tools-backends-2.0 / scripts / Utils / File.pm < prev    next >
Encoding:
Perl POD Document  |  2009-04-09  |  18.8 KB  |  923 lines
  1. #!/usr/bin/perl
  2. #-*- Mode: perl; tab-width: 2; indent-tabs-mode: nil; c-basic-offset: 2 -*-
  3.  
  4. # Functions for file manipulation. Find, open, read, write, backup, etc.
  5. #
  6. # Copyright (C) 2000-2001 Ximian, Inc.
  7. #
  8. # Authors: Hans Petter Jansson <hpj@ximian.com>
  9. #          Arturo Espinosa <arturo@ximian.com>
  10. #
  11. # This program is free software; you can redistribute it and/or modify
  12. # it under the terms of the GNU Library General Public License as published
  13. # by the Free Software Foundation; either version 2 of the License, or
  14. # (at your option) any later version.
  15. #
  16. # This program is distributed in the hope that it will be useful,
  17. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19. # GNU Library General Public License for more details.
  20. #
  21. # You should have received a copy of the GNU Library General Public License
  22. # along with this program; if not, write to the Free Software
  23. # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
  24.  
  25. package Utils::File;
  26.  
  27. use Utils::Report;
  28. use File::Path;
  29. use File::Copy;
  30. use File::Temp;
  31. use Carp;
  32.  
  33. $FILE_READ  = 1;
  34. $FILE_WRITE = 2;
  35.  
  36.  
  37. # --- File operations --- #
  38.  
  39. sub get_base_path
  40. {
  41.   my $path = "/$main::localstatedir/cache/system-tools-backends";
  42.   chmod (0755, $path);
  43.   return $path;
  44. }
  45.  
  46.  
  47. sub get_tmp_path
  48. {
  49.   return (&get_base_path () . "/tmp");
  50. }
  51.  
  52.  
  53. sub get_backup_path
  54. {
  55.   return (&get_base_path () . "/backup");
  56. }
  57.  
  58. # Give a command, and it will put in C locale, some sane PATH values and find
  59. # the program to run in the path. Redirects stderr to null.
  60. sub do_get_cmd_path
  61. {
  62.   my ($cmd) = @_;
  63.   my ($tool_name, @argline, $command, $tool_path);
  64.   
  65.   ($tool_name, @argline) = split("[ \t]+", $cmd);
  66.  
  67.   $tool_path = &locate_tool ($tool_name);
  68.   return -1 if ($tool_path eq "");
  69.  
  70.   $command = "$tool_path @argline";
  71.   # Do not escape args, it's reasonable
  72.   # to assume they're already escaped
  73.   #$command =~ s/\"/\\\"/g;
  74.  
  75.   return $command;
  76. }
  77.  
  78. sub get_cmd_path
  79. {
  80.    my ($cmd) = @_;
  81.  
  82.    my $command = &do_get_cmd_path ($cmd);
  83.  
  84.    return -1 if ($command == -1);
  85.    return ("LC_ALL=C PATH=\$PATH:/sbin:/usr/sbin $command 2> /dev/null");
  86. }
  87.  
  88. # necessary for some programs that output info through stderr
  89. sub get_cmd_path_with_stderr
  90. {
  91.    my ($cmd) = @_;
  92.  
  93.    my $command = &get_cmd_path ($cmd);
  94.    return ("LC_ALL=C PATH=\$PATH:/sbin:/usr/sbin $command 2>&1");
  95. }
  96.  
  97.  
  98. sub create_path
  99. {
  100.   my ($path, $perms) = @_;
  101.   $prems = $perms || 0770;
  102.   my @pelem;
  103.   
  104.   $path =~ tr/\///s;
  105.   @pelem = split(/\//, $path); # 'a/b/c/d/' -> 'a', 'b', 'c', 'd', ''
  106.  
  107.   for ($path = ""; @pelem; shift @pelem)
  108.   {
  109.     $path = "$path$pelem[0]";
  110.     mkdir($path, $perms);
  111.     $path = "$path/";
  112.   }
  113.  
  114.   &Utils::Report::enter ();
  115.   &Utils::Report::do_report ("file_create_path", $_[0]);
  116.   &Utils::Report::leave ();
  117. }
  118.  
  119.  
  120. sub create_path_for_file
  121. {
  122.   my ($path, $perms) = @_;
  123.   $prems = $perms || 0770;
  124.   my @pelem;
  125.   
  126.   $path =~ tr/\///s;
  127.   @pelem = split(/\//, $path); # 'a/b/c/d/' -> 'a', 'b', 'c', 'd', ''
  128.     
  129.   for ($path = ""; @pelem; shift @pelem)
  130.   {
  131.     if ($pelem[1] ne "")
  132.     {
  133.       $path = "$path$pelem[0]";
  134.       mkdir($path, $perms);
  135.       $path = "$path/";
  136.     }
  137.   }
  138.  
  139.   &Utils::Report::enter ();
  140.   &Utils::Report::do_report ("file_create_path", $_[0]);
  141.   &Utils::Report::leave ();
  142. }
  143.  
  144.  
  145. $rotation_was_made = 0;
  146.  
  147. # If this is the first backup created by this tool on this invocation,
  148. # rotate the backup directories and create a new, empty one.
  149. sub rotate_backup_dirs
  150. {
  151.   my $backup_tool_dir = $_[0];
  152.   
  153.   &Utils::Report::enter ();
  154.   
  155.   if (!$rotation_was_made)
  156.   {
  157.     my $i;
  158.  
  159.     $rotation_was_made = 1;
  160.     if (-e "$backup_tool_dir/9")
  161.     {
  162.       if (-s "$backup_tool_dir/9")
  163.       {
  164.         unlink ("$backup_tool_dir/9");
  165.       }
  166.       else
  167.       {
  168.         &rmtree ("$backup_tool_dir/9");
  169.       }
  170.     }
  171.  
  172.     for ($i = 8; $i; $i--)
  173.     {
  174.       if (stat ("$backup_tool_dir/$i"))
  175.       {
  176.         move ("$backup_tool_dir/$i", "$backup_tool_dir/" . ($i+1));
  177.       }
  178.     }
  179.  
  180.     if (!stat ("$backup_tool_dir/First"))
  181.     {
  182.       &create_path ("$backup_tool_dir/First");
  183.       &run ("ln -s First $backup_tool_dir/1");
  184.     }
  185.     else
  186.     {
  187.       &create_path_for_file ("$backup_tool_dir/1/");
  188.     }
  189.  
  190.     &Utils::Report::do_report ("file_backup_rotate", $backup_tool_dir);
  191.   }
  192.   
  193.   &Utils::Report::enter ();
  194. }
  195.  
  196. sub do_backup
  197. {
  198.   my $backup_file = $_[0];
  199.   my $backup_tool_dir;
  200.  
  201.   &Utils::Report::enter ();
  202.   
  203.   $backup_tool_dir = &get_backup_path () . "/$gst_name/";
  204.  
  205.   &rotate_backup_dirs ($backup_tool_dir);
  206.   
  207.   # If the file hasn't already been backed up on this invocation, copy the
  208.   # file to the backup directory.
  209.  
  210.   if (!stat ("$backup_tool_dir/1/$backup_file"))
  211.   {
  212.     &create_path_for_file ("$backup_tool_dir/1/$backup_file");
  213.     copy ($backup_file, "$backup_tool_dir/1/$backup_file");
  214.     &Utils::Report::do_report ("file_backup_success", $backup_tool_dir);
  215.   }
  216.   
  217.   &Utils::Report::leave ();
  218. }
  219.  
  220. # Return 1/0 depending on file existance.
  221. sub exists
  222. {
  223.   my ($file) = @_;
  224.  
  225.   return (-f "$gst_prefix/$file")? 1: 0;
  226. }
  227.  
  228. sub open_read_from_names
  229. {
  230.   local *FILE;
  231.   my $fname = "";
  232.  
  233.   &Utils::Report::enter ();
  234.   
  235.   foreach $name (@_)
  236.   {
  237.     if (open (FILE, "$gst_prefix/$name"))
  238.     {
  239.       $fname = $name;
  240.       last;
  241.     }
  242.   }
  243.   
  244.   (my $fullname = "$gst_prefix/$fname") =~ tr/\//\//s;  # '//' -> '/'    
  245.  
  246.   if ($fname eq "") 
  247.   { 
  248.     &Utils::Report::do_report ("file_open_read_failed", "@_");
  249.     return undef;
  250.   }
  251.  
  252.   &Utils::Report::do_report ("file_open_read_success", $fullname);
  253.   &Utils::Report::leave ();
  254.  
  255.   return *FILE;
  256. }
  257.  
  258.  
  259. sub open_write_from_names
  260. {
  261.   local *FILE;
  262.   my $name;
  263.   my $fullname;
  264.  
  265.   &Utils::Report::enter ();
  266.     
  267.   # Find out where it lives.
  268.     
  269.   foreach $elem (@_) { if (stat($elem) ne "") { $name = $elem; last; } }
  270.     
  271.   if ($name eq "")
  272.   {
  273.     $name = $_[0];
  274.     (my $fullname = "$gst_prefix/$name") =~ tr/\//\//s;
  275.     &Utils::Report::do_report ("file_open_write_create", "@_", $fullname);
  276.   }
  277.   else
  278.   {
  279.     (my $fullname = "$gst_prefix/$name") =~ tr/\//\//s;
  280.     &Utils::Report::do_report ("file_open_write_success", $fullname);
  281.   }
  282.     
  283.   ($name = "$gst_prefix/$name") =~ tr/\//\//s;  # '//' -> '/' 
  284.   &create_path_for_file ($name);
  285.     
  286.   # Make a backup if the file already exists - if the user specified a prefix,
  287.   # it might not.
  288.     
  289.   if (stat ($name))
  290.   {
  291.     &do_backup ($name);
  292.   }
  293.  
  294.   &Utils::Report::leave ();
  295.   
  296.   # Truncate and return filehandle.
  297.  
  298.   if (!open (FILE, ">$name"))
  299.   {
  300.     &Utils::Report::do_report ("file_open_write_failed",  $name);
  301.     return undef;
  302.   }
  303.  
  304.   return *FILE;
  305. }
  306.  
  307. sub open_filter_write_from_names
  308. {
  309.   local *INFILE;
  310.   local *OUTFILE;
  311.   my ($filename, $name, $elem);
  312.  
  313.   &Utils::Report::enter ();
  314.  
  315.   # Find out where it lives.
  316.  
  317.   foreach $coin (@_)
  318.   {
  319.     if (-e $coin) { $name = $coin; last; }
  320.   }
  321.  
  322.   if (! -e $name)
  323.   {
  324.     # If we couldn't locate the file, and have no prefix, give up.
  325.  
  326.     # If we have a prefix, but couldn't locate the file relative to '/',
  327.     # take the first name in the array and let that be created in $prefix.
  328.  
  329.     if ($prefix eq "")
  330.     {
  331.       &Utils::Report::do_report ("file_open_filter_failed", "@_");
  332.       return(0, 0);
  333.     }
  334.     else
  335.     {
  336.       $name = $_[0];
  337.       (my $fullname = "$gst_prefix/$name") =~ tr/\//\//s;
  338.       &Utils::Report::do_report ("file_open_filter_create", "@_", $fullname);
  339.     }
  340.   }
  341.   else
  342.   {
  343.     (my $fullname = "$gst_prefix/$name") =~ tr/\//\//s;
  344.     &Utils::Report::do_report ("file_open_filter_success", $name, $fullname);
  345.   }
  346.  
  347.   ($filename) = $name =~ /.*\/(.+)$/;
  348.   ($name = "$gst_prefix/$name") =~ tr/\//\//s;  # '//' -> '/' 
  349.   &create_path_for_file ($name);
  350.  
  351.   # Make a backup if the file already exists - if the user specified a prefix,
  352.   # it might not.
  353.  
  354.   if (-e $name)
  355.   {
  356.     &do_backup ($name);
  357.   }
  358.  
  359.   # Return filehandles. Make a copy to use as filter input. It might be
  360.   # invalid (no source file), in which case the caller should just write to
  361.   # OUTFILE without bothering with INFILE filtering.
  362.  
  363.   my $tmp_path = &get_tmp_path ();
  364.  
  365.   &create_path ("$tmp_path");
  366.   unlink ("$tmp_path/$gst_name-$filename");
  367.   copy ($name, "$tmp_path/$gst_name-$filename");
  368.  
  369.   open (INFILE, "$tmp_path/$gst_name-$filename");
  370.  
  371.   if (!open (OUTFILE, ">$name"))
  372.   {
  373.     &Utils::Report::do_report ("file_open_filter_failed", $name);
  374.     return (*INFILE, 0);
  375.   }
  376.     
  377.   &Utils::Report::leave ();
  378.  
  379.   return (*INFILE, *OUTFILE);
  380. }
  381.  
  382.  
  383. sub open_write_compressed
  384. {
  385.   local *FILE;
  386.   my ($name, $fullname, $gzip);
  387.  
  388.   $gzip = &locate_tool ("gzip");
  389.   return undef if (!$gzip);
  390.  
  391.   &Utils::Report::enter ();
  392.     
  393.   # Find out where it lives.
  394.     
  395.   foreach $elem (@_) { if (stat($elem) ne "") { $name = $elem; last; } }
  396.     
  397.   if ($name eq "")
  398.   {
  399.     $name = $_[0];
  400.     (my $fullname = "$gst_prefix/$name") =~ tr/\//\//s;
  401.     &Utils::Report::do_report ("file_open_write_create", "@_", $fullname);
  402.   }
  403.   else
  404.   {
  405.     (my $fullname = "$gst_prefix/$name") =~ tr/\//\//s;
  406.     &Utils::Report::do_report ("file_open_write_success", $fullname);
  407.   }
  408.     
  409.   ($name = "$gst_prefix/$name") =~ tr/\//\//s;  # '//' -> '/' 
  410.   &create_path_for_file ($name);
  411.     
  412.   # Make a backup if the file already exists - if the user specified a prefix,
  413.   # it might not.
  414.     
  415.   if (stat ($name))
  416.   {
  417.     &do_backup ($name);
  418.   }
  419.  
  420.   &Utils::Report::leave ();
  421.   
  422.   # Truncate and return filehandle.
  423.  
  424.   if (!open (FILE, "| $gzip -c > $name"))
  425.   {
  426.     &Utils::Report::do_report ("file_open_write_failed",  $name);
  427.     return;
  428.   }
  429.  
  430.   return *FILE;
  431. }
  432.  
  433.  
  434. sub run_pipe
  435. {
  436.   my ($cmd, $mode_mask, $stderr) = @_;
  437.   my ($command);
  438.   local *PIPE;
  439.  
  440.   $mode_mask = $FILE_READ if $mode_mask eq undef;
  441.  
  442.   &Utils::Report::enter ();
  443.   
  444.   if ($stderr)
  445.   {
  446.     $command = &get_cmd_path_with_stderr ($cmd);
  447.   }
  448.   else
  449.   {
  450.     $command = &get_cmd_path ($cmd);
  451.   }
  452.  
  453.   if ($command == -1)
  454.   {
  455.     &Utils::Report::do_report ("file_run_pipe_failed", $command);
  456.     &Utils::Report::leave ();
  457.     return undef;
  458.   }
  459.  
  460.   $command .= " |" if $mode_mask & $FILE_READ;
  461.   $command = "| $command > /dev/null" if $mode_mask & $FILE_WRITE;
  462.  
  463.   open PIPE, $command;
  464.   &Utils::Report::do_report ("file_run_pipe_success", $command);
  465.   &Utils::Report::leave ();
  466.   return *PIPE;
  467. }
  468.  
  469.  
  470. sub run_pipe_read
  471. {
  472.   my ($cmd) = @_;
  473.  
  474.   return &run_pipe ($cmd, $FILE_READ);
  475. }
  476.  
  477. sub run_pipe_read_with_stderr
  478. {
  479.    my ($cmd) = @_;
  480.  
  481.    return &run_pipe ($cmd, $FILE_READ, 1);
  482. }
  483.  
  484. sub run_pipe_write
  485. {
  486.   my ($cmd) = @_;
  487.  
  488.   return &run_pipe ($cmd, $FILE_WRITE);
  489. }
  490.  
  491.  
  492. sub run_backtick
  493. {
  494.   my ($cmd, $stderr) = @_;
  495.   my ($fd, $res);
  496.  
  497.   if ($stderr)
  498.   {
  499.     $fd = &run_pipe_read_with_stderr ($cmd);
  500.   }
  501.   else
  502.   {
  503.     $fd = &run_pipe_read ($cmd);
  504.   }
  505.  
  506.   $res = join ('', <$fd>);
  507.   &close_file ($fd);
  508.  
  509.   return $res;
  510. }
  511.  
  512.  
  513. sub close_file
  514. {
  515.   my ($fd) = @_;
  516.  
  517.   close $fd if (ref \$fd eq "GLOB");
  518. }
  519.  
  520.  
  521. sub remove
  522. {
  523.   my ($name) = @_;
  524.   my ($file);
  525.  
  526.   &Utils::Report::enter ();
  527.   &Utils::Report::do_report ("file_remove", $name);
  528.  
  529.   $file = "$gst_prefix/$name";
  530.  
  531.   if (stat ($file))
  532.   {
  533.     &do_backup ($file);
  534.   }
  535.  
  536.   unlink $file;
  537.   &Utils::Report::leave ();
  538. }
  539.  
  540. sub rmtree
  541. {
  542.   my($roots, $verbose, $safe) = @_;
  543.   my(@files);
  544.   my($count) = 0;
  545.   $verbose ||= 0;
  546.   $safe ||= 0;
  547.  
  548.   if ( defined($roots) && length($roots) ) {
  549.     $roots = [$roots] unless ref $roots;
  550.   }
  551.   else {
  552.     carp "No root path(s) specified\n";
  553.     return 0;
  554.   }
  555.  
  556.   my($root);
  557.   foreach $root (@{$roots}) {
  558.     $root =~ s#/\z##;
  559.     (undef, undef, my $rp) = lstat $root or next;
  560.     $rp &= 07777;    # don't forget setuid, setgid, sticky bits
  561.     
  562.     if ( -d $root ) { # $root used to be _, which is a bug.
  563.                       # this is why we are replicating this function.
  564.       
  565.         # notabene: 0777 is for making readable in the first place,
  566.         # it's also intended to change it to writable in case we have
  567.         # to recurse in which case we are better than rm -rf for 
  568.         # subtrees with strange permissions
  569.         chmod(0777, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
  570.           or carp "Can't make directory $root read+writeable: $!"
  571.               unless $safe;
  572.  
  573.       local *DIR;
  574.         if (opendir DIR, $root) {
  575.         @files = readdir DIR;
  576.         closedir DIR;
  577.         }
  578.         else {
  579.         carp "Can't read $root: $!";
  580.         @files = ();
  581.         }
  582.  
  583.         # Deleting large numbers of files from VMS Files-11 filesystems
  584.         # is faster if done in reverse ASCIIbetical order 
  585.         @files = reverse @files if $Is_VMS;
  586.         ($root = VMS::Filespec::unixify($root)) =~ s#\.dir\z## if $Is_VMS;
  587.         @files = map("$root/$_", grep $_!~/^\.{1,2}\z/s,@files);
  588.         $count += &rmtree(\@files,$verbose,$safe);
  589.         if ($safe &&
  590.           ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
  591.         print "skipped $root\n" if $verbose;
  592.         next;
  593.         }
  594.         chmod 0777, $root
  595.           or carp "Can't make directory $root writeable: $!"
  596.               if $force_writeable;
  597.         print "rmdir $root\n" if $verbose;
  598.         if (rmdir $root) {
  599.         ++$count;
  600.         }
  601.         else {
  602.         carp "Can't remove directory $root: $!";
  603.         chmod($rp, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
  604.             or carp("and can't restore permissions to "
  605.                     . sprintf("0%o",$rp) . "\n");
  606.         }
  607.     }
  608.     else { 
  609.         if ($safe &&
  610.           ($Is_VMS ? !&VMS::Filespec::candelete($root)
  611.            : !(-l $root || -w $root)))
  612.         {
  613.         print "skipped $root\n" if $verbose;
  614.         next;
  615.         }
  616.         chmod 0666, $root
  617.           or carp "Can't make file $root writeable: $!"
  618.               if $force_writeable;
  619.         print "unlink $root\n" if $verbose;
  620.         # delete all versions under VMS
  621.         for (;;) {
  622.         unless (unlink $root) {
  623.           carp "Can't unlink file $root: $!";
  624.           if ($force_writeable) {
  625.             chmod $rp, $root
  626.                 or carp("and can't restore permissions to "
  627.                         . sprintf("0%o",$rp) . "\n");
  628.           }
  629.           last;
  630.         }
  631.         ++$count;
  632.         last unless $Is_VMS && lstat $root;
  633.         }
  634.     }
  635.   }
  636.  
  637.   $count;
  638. }
  639.  
  640. # --- Buffer operations --- #
  641.  
  642.  
  643. # Open $file and put it into @buffer, for in-line editting.
  644. # \@buffer on success, undef on error.
  645.  
  646. sub load_buffer
  647. {
  648.   my ($file) = @_;
  649.   my @buffer;
  650.   my $fd;
  651.  
  652.   &Utils::Report::enter ();
  653.   &Utils::Report::do_report ("file_buffer_load", $file);
  654.  
  655.   $fd = &open_read_from_names ($file);
  656.   return [] unless $fd;
  657.  
  658.   @buffer = (<$fd>);
  659.  
  660.   &Utils::Report::leave ();
  661.  
  662.   return \@buffer;
  663. }
  664.  
  665. # Same with an already open fd.
  666. sub load_buffer_from_fd
  667. {
  668.   my ($fd) = @_;
  669.   my (@buffer);
  670.   
  671.   &Utils::Report::enter ();
  672.   &Utils::Report::do_report ("file_buffer_load", $file);
  673.  
  674.   @buffer = (<$fd>);
  675.  
  676.   &Utils::Report::leave ();
  677.  
  678.   return \@buffer;
  679. }
  680.  
  681. # Take a $buffer and save it in $file. -1 is error, 0 success.
  682.  
  683. sub save_buffer
  684. {
  685.   my ($buffer, $file) = @_;
  686.   my ($fd, $i);
  687.  
  688.   &Utils::Report::enter ();
  689.   &Utils::Report::do_report ("file_buffer_save", $file);
  690.  
  691.   $fd = &open_write_from_names ($file);
  692.   return -1 if !$fd;
  693.  
  694.   if (@$buffer < 1)
  695.   {
  696.     # We want to write single line.
  697.     # Print only if $buffer is NOT a reference (it'll print ARRAY(0x412493) for example).
  698.     print $fd $buffer if (!ref ($buffer));
  699.   }
  700.  
  701.   else
  702.   {
  703.     # Let's print array
  704.     
  705.     foreach $i (@$buffer)
  706.     {
  707.       print $fd $i;
  708.     }
  709.   }
  710.  
  711.   &close_file ($fd);
  712.  
  713.   &Utils::Report::leave ();
  714.   
  715.   return 0;
  716. }
  717.  
  718.  
  719. # Erase all empty string elements from the $buffer.
  720.  
  721. sub clean_buffer
  722. {
  723.   my $buffer = $_[0];
  724.   my $i;
  725.  
  726.   for ($i = 0; $i <= $#$buffer; $i++)
  727.   {
  728.     splice (@$buffer, $i, 1) if $$buffer[$i] eq "";
  729.   }
  730. }
  731.  
  732.  
  733. sub join_buffer_lines
  734. {
  735.   my $buffer = $_[0];
  736.   my $i;
  737.  
  738.   for ($i = 0; $i <= $#$buffer; $i++)
  739.   {
  740.     while ($$buffer[$i] =~ /\\$/)
  741.     {
  742.       chomp $$buffer[$i];
  743.       chop $$buffer[$i];
  744.       $$buffer[$i] .= $$buffer[$i + 1];
  745.       splice (@$buffer, $i + 1, 1);
  746.     }
  747.   }
  748. }
  749.  
  750. sub read_joined_lines
  751. {
  752.   my ($file) = @_;
  753.   my ($buffer);
  754.  
  755.   $buffer = &load_buffer ($file);
  756.   &join_buffer_lines ($buffer);
  757.  
  758.   $$buffer[0] =~ s/\n//;
  759.   $$buffer[0] =~ s/\\//;
  760.  
  761.   return $$buffer[0];
  762. }
  763.  
  764. # --- Command-line utilities --- #
  765.  
  766.  
  767. # &run (<command line>)
  768. #
  769. # Assumes the first word on the command line is the command-line utility
  770. # to run, and tries to locate it, replacing it with its full path. The path
  771. # is cached in a hash, to avoid searching for it repeatedly. Output
  772. # redirection is appended, to make the utility perfectly silent. The
  773. # preprocessed command line is run, and its exit value is returned.
  774. #
  775. # Example: "mkswap /dev/hda3" -> 'PATH=$PATH:/sbin:/usr/sbin /sbin/mkswap /dev/hda3 2>/dev/null >/dev/null'.
  776.  
  777. sub run
  778. {
  779.   my ($cmd, $background) = @_;
  780.   my ($command, $tool_name, $tool_path, @argline);
  781.  
  782.   &Utils::Report::enter ();
  783.  
  784.   $command = &get_cmd_path ($cmd);
  785.   return -1 if $command == -1;
  786.   $command .= " > /dev/null";
  787.   $command .= " &" if $background;
  788.  
  789.   &Utils::Report::do_report ("file_run", $command);
  790.   &Utils::Report::leave ();
  791.  
  792.   # As documented in perlfunc, divide by 256.
  793.   return (system ($command) / 256);
  794. }
  795.  
  796. sub run_bg
  797. {
  798.   my ($cmd) = @_;
  799.  
  800.   return &run ($cmd, 1);
  801. }
  802.  
  803. # &gst_file_locate_tool
  804. #
  805. # Tries to locate a command-line utility from a set of built-in paths
  806. # and a set of user paths (found in the environment). The path (or a negative
  807. # entry) is cached in a hash, to avoid searching for it repeatedly.
  808.  
  809. @gst_builtin_paths = ( "/sbin", "/usr/sbin", "/usr/local/sbin",
  810.                        "/bin", "/usr/bin", "/usr/local/bin" );
  811.  
  812. %gst_tool_paths = ();
  813.  
  814. sub locate_tool
  815. {
  816.   my ($tool) = @_;
  817.   my $found = "";
  818.   my @user_paths;
  819.  
  820.   # We don't search absolute paths. Arturo.
  821.   if ($tool =~ /^\//)
  822.   {
  823.     if (! (-x $tool))
  824.     {
  825.       &Utils::Report::do_report ("file_locate_tool_failed", $tool);
  826.       return "";
  827.     }
  828.     
  829.     return $tool;
  830.   }
  831.  
  832.   &Utils::Report::enter ();
  833.   
  834.   $found = $gst_tool_paths{$tool};
  835.   if ($found eq "0")
  836.   {
  837.     # Negative cache hit. At this point, the failure has already been reported
  838.     # once.
  839.     return "";
  840.   }
  841.  
  842.   if ($found eq "")
  843.   {
  844.     # Nothing found in cache. Look for real.
  845.  
  846.     # Extract user paths to try.
  847.  
  848.     @user_paths = ($ENV{PATH} =~ /([^:]+):/mg);
  849.  
  850.     # Try user paths.
  851.  
  852.     foreach $path (@user_paths)
  853.     {
  854.       if (-x "$path/$tool" || -u "$path/$tool") { $found = "$path/$tool"; last; }
  855.     }
  856.  
  857.     if (!$found)
  858.     {
  859.       # Try builtin paths.
  860.       foreach $path (@gst_builtin_paths)
  861.       {
  862.         if (-x "$path/$tool" || -u "$path/$tool") { $found = "$path/$tool"; last; }
  863.       }
  864.     }
  865.  
  866.     # Report success/failure and update cache.
  867.  
  868.     if ($found)
  869.     {
  870.       $gst_tool_paths{$tool} = $found;
  871.       &Utils::Report::do_report ("file_locate_tool_success", $tool);
  872.     }
  873.     else
  874.     {
  875.       $gst_tool_paths{$tool} = "0";
  876.       &Utils::Report::do_report ("file_locate_tool_failed", $tool);
  877.     }
  878.   }
  879.   
  880.   &Utils::Report::leave ();
  881.   
  882.   return ($found);
  883. }
  884.  
  885. sub tool_installed
  886. {
  887.   my ($tool) = @_;
  888.   
  889.   $tool = &locate_tool ($tool);
  890.   return 0 if $tool eq "";
  891.   return 1;
  892. }
  893.  
  894. sub copy_file
  895. {
  896.   my ($orig, $dest) = @_;
  897.  
  898.   return if (!&exists ("$gst_prefix/$orig"));
  899.   copy ("$gst_prefix/$orig", "$gst_prefix/$dest");
  900. }
  901.  
  902. sub get_temp_name
  903. {
  904.   my ($prefix) = @_;
  905.  
  906.   return mktemp ($prefix);
  907. }
  908.  
  909. sub copy_file_from_stock
  910. {
  911.   my ($orig, $dest) = @_;
  912.  
  913.   if (!copy ("$main::filesdir/$orig", $dest))
  914.   {
  915.     &Utils::Report::do_report ("file_copy_failed", "$main::filesdir/$orig", $dest);
  916.     return -1;
  917.   }
  918.  
  919.   return 0;
  920. }
  921.  
  922. 1;
  923.